home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtpopups.i < prev    next >
Text File  |  1997-10-26  |  16KB  |  463 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtPopups;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *  3.01     | 03.02.92 |  Hp  | Auf das neue MoveArea umgestellt.      *
  29.  *-----------+----------+------+----------------------------------------*)
  30.  
  31.  
  32.  
  33. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  34. (*                                              *)
  35. (*$R-   Range-Checks                            *)
  36. (*$S-   Stack-Check                             *)
  37. (*                                              *)
  38. (*----------------------------------------------*)
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  46.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  47.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  48.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  49.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  50.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  51.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  52.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59. FROM SYSTEM     IMPORT  ADDRESS, ADR;
  60. FROM MagicAES   IMPORT  GBOX, GTEXT, GBOXTEXT, GIBOX, GSTRING, GTITLE,
  61.                         Exit, DISABLED, SELECTABLE, OBJECT, ObjcDraw, ObjcFind, TEDINFO,
  62.                         BEGMCTRL, ENDMCTRL, WindUpdate, WFFULLXYWH, WindGet,
  63.                         FormButton, GrafHandle, MUKEYBD, MUBUTTON, MUM1, 
  64.                         MUM2, MUMESAG, MUTIMER, EvntMulti, AESIntIn, AESIntOut,
  65.                         AESCall;
  66. FROM mtAppl     IMPORT  PrivateWS, MouseOn, MouseOff, MouseArrow, MouseHand,
  67.                         CharWidth, CharHeight, BoxWidth, BoxHeight, StoreMouse,
  68.                         DeskX, DeskY, MaxWidth, MaxHeight, RestoreMouse;
  69. FROM mtArea     IMPORT  AREA, NewAREA, DisposeAREA, FreeArea, SaveArea,
  70.                         CopyArea, RestoreArea, MoveArea;
  71. FROM mtUtils    IMPORT  tRect, tObjcTree, Bounce, ScanFlags, SearchType,
  72.                         CalcArea, ObjcFrame, Max;
  73. FROM mtMenubase IMPORT  SameLength, DoEvent, ScreenDim, DrawBar, MenuKeyboard,
  74.                         PlaceOnScreen;
  75. FROM MagicStrings  IMPORT  Assign, Append, Length;
  76. IMPORT  MagicAES, MagicVDI;
  77.  
  78. CONST   cStrMax =       50;
  79.  
  80. TYPE    tString =       ARRAY [0..cStrMax] OF CHAR;
  81.         tTedPtr =       POINTER TO TEDINFO;
  82.  
  83. VAR     Main:           ARRAY [0..51] OF OBJECT;
  84.         MainTitle:      TEDINFO;
  85.         Sub:            ARRAY [0..51] OF OBJECT;
  86.         SubTitle:       TEDINFO;
  87.         mainArea:       AREA;
  88.         subArea:        AREA;
  89.         SubBegin:       sINTEGER;
  90.         b:              sBITSET;
  91.         bool, rekExit:  BOOLEAN;
  92.         screen:         tRect;
  93.         mW, mH:         sINTEGER;
  94.         moveable:       BOOLEAN;
  95.  
  96.  
  97. PROCEDURE DoMenu (t: tObjcTree; moveable: BOOLEAN; area: AREA): sINTEGER;
  98. CONST Links =  Bit0;
  99. VAR x, y, ox, oy, i, f, j, o, d, xx, yy: sINTEGER;
  100.     ob, oldob, taste, scan, clicks, minobj: sINTEGER;
  101.     button, kbshift, event, b: sBITSET;
  102.     bool: BOOLEAN;
  103.     ascii: CHAR;
  104.     fr: tRect;
  105.     fa: AREA;
  106. BEGIN
  107.  i:= MagicVDI.SetWritemode (PrivateWS, MagicVDI.XOR);
  108.  i:= MagicVDI.SetFillcolor (PrivateWS, 1); 
  109.  bool:= MagicVDI.SetFillperimeter (PrivateWS, FALSE);
  110.  oldob:= -1;  ob:= -1;  ox:= -1;  oy:= -1;
  111.  IF moveable THEN  minobj:= 2;  ELSE  minobj:= 1; END;
  112.  StoreMouse;
  113.  WindUpdate (BEGMCTRL);
  114.  LOOP
  115.   event:= DoEvent (x, y, button, scan);
  116.   IF (x # ox) OR (y # oy) THEN
  117.    ob:= MagicAES.ObjcFind (t, 0, 999, x, y);  ox:= x;  oy:= y;
  118.    IF ob # oldob THEN
  119.     MouseOff;  DrawBar (t, oldob);  oldob:= -1;
  120.     IF (ob >= minobj) AND NOT (DISABLED IN t^[ob].obState) AND (SELECTABLE IN t^[ob].obFlags) THEN
  121.      DrawBar (t, ob);  oldob:= ob;
  122.     END;
  123.     MouseOn;
  124.    END;
  125.   END;
  126.   IF (MUKEYBD IN event) THEN
  127.    IF MenuKeyboard (t, scan, minobj, oldob, ob) THEN
  128.     MouseOff;  DrawBar (t, oldob);  MouseOn;  EXIT;
  129.    END;
  130.    IF ob # oldob THEN
  131.     MouseOff;  
  132.     DrawBar (t, oldob);  DrawBar (t, ob);  oldob:= ob;
  133.     MouseOn;
  134.    END;
  135.   ELSIF (MUBUTTON IN event) THEN
  136.    IF (ob = 1) AND moveable THEN
  137.     MouseHand;
  138.     bool:= NewAREA (fa);
  139.     f:= ObjcFrame (t, 0);  IF f < 0 THEN f:= ABS (f) ELSE f:= 0;  END;
  140.     LOOP
  141.      MagicAES.GrafMkstate (x, y, button, b);
  142.      IF NOT (Links IN button) THEN  EXIT;  END;
  143.      IF (x # ox) OR (y # oy) THEN
  144.       CalcArea (t, 0, fr);
  145.       IF SaveArea (PrivateWS, fa, fr) THEN
  146.        MoveArea (PrivateWS, area, x - ox, y - oy, xx, yy);
  147.        t^[0].obY:= yy + f;  t^[0].obX:= xx + f;
  148.        CalcArea (t, 0, fr);  CopyArea (PrivateWS, fa, fr.x, fr.y);
  149.        ox:= x;  oy:= y;
  150.       END;
  151.      END;
  152.     END; (* LOOP *)
  153.     CalcArea (t, 0, fr);  CopyArea (PrivateWS, fa, fr.x, fr.y);
  154.     DisposeAREA (fa);
  155.     MouseArrow;
  156.    ELSE
  157.     LOOP
  158.      MagicAES.GrafMkstate (x, y, button, kbshift);
  159.      IF NOT (Links IN button) THEN  EXIT;  END;
  160.      o:= MagicAES.ObjcFind (t, 0, 999, x, y);
  161.      IF o # ob THEN  EXIT;  END;
  162.     END;
  163.     IF NOT (Links IN button) THEN
  164.      IF (ob >= minobj) THEN  MouseOff;  DrawBar (t, ob);  MouseOn;  END;
  165.      EXIT;  
  166.     END;
  167.    END;
  168.   END;
  169.  END; (* LOOP *)
  170.  i:= MagicVDI.SetWritemode (PrivateWS, MagicVDI.REPLACE);
  171.  i:= MagicVDI.SetFillcolor (PrivateWS, 0);
  172.  RestoreMouse;
  173.  WindUpdate (ENDMCTRL);
  174.  IF (ob >= 0) & (DISABLED IN t^[ob].obState)
  175.  THEN
  176.    ob := -1
  177.  END;
  178.  RETURN ob;
  179. END DoMenu;
  180.  
  181. PROCEDURE SetObjc (t: tObjcTree; objc, typ, x, y, w, h: sINTEGER;
  182.                    f, s: sBITSET; spec: ADDRESS);
  183. BEGIN
  184.  t^[objc].obNext:= -1;
  185.  t^[objc].obHead:= -1;
  186.  t^[objc].obTail:= -1;
  187.  t^[objc].obType:= typ;
  188.  t^[objc].obFlags:= f;
  189.  t^[objc].obState:= s;
  190.  t^[objc].obSpec.address:= spec;
  191.  t^[objc].obX:= x;
  192.  t^[objc].obY:= y;
  193.  t^[objc].obWidth:= w;
  194.  t^[objc].obHeight:= h;
  195.  MagicAES.ObjcAdd (t, 0, objc);
  196. END SetObjc;
  197.  
  198.  
  199. PROCEDURE PosMenu (menu: tObjcTree; ob, maxW, maxH: sINTEGER);
  200. VAR x, y: sINTEGER;
  201.     b: sBITSET;
  202. BEGIN
  203.  WITH menu^[0] DO
  204.   IF ob > 0 THEN
  205.    x:= Main[0].obX + Main[ob].obX + (Main[ob].obWidth DIV 2);
  206.    y:= Main[0].obY + Main[ob].obY - (CharWidth DIV 2);
  207.   ELSE
  208.    MagicAES.GrafMkstate (x, y, b, b);
  209.   END;
  210.   obX:= x;  obY:= y;  obWidth:= maxW;  obHeight:= maxH;
  211.   PlaceOnScreen (menu);
  212.  END;
  213. END PosMenu;
  214.  
  215.  
  216. PROCEDURE MakeMenu (tree, menu: tObjcTree; title: ADDRESS;
  217.                     subnum, type: sINTEGER): sINTEGER;
  218. VAR maxW, maxH, num, i, j, ob, len, offset: sINTEGER;
  219.     ted: tTedPtr;
  220. BEGIN
  221.  ted:= title;  len:= ted^.teTxtlen;
  222.  j:= 0;  num:= 0;  maxW:= (len + 4) * CharWidth;  maxH:= CharHeight + 1;  
  223.  (*-- Basisobjekt --*)
  224.  menu^[num].obNext:= -1;
  225.  menu^[num].obHead:= -1;
  226.  menu^[num].obTail:= -1;
  227.  menu^[num].obType:= GBOX;
  228.  menu^[num].obFlags:= {};
  229.  menu^[num].obState:= {};
  230.  menu^[num].obSpec.Box.char:=  0C;
  231.  menu^[num].obSpec.Box.frame:= 377C;
  232.  menu^[num].obSpec.Box.flags:= {Bit12, Bit11};
  233.  menu^[num].obX:= 0;
  234.  menu^[num].obY:= 0;
  235.  menu^[num].obWidth:= 0;
  236.  menu^[num].obHeight:= 0;
  237.  INC (num);
  238.  (*-- Titelzeile --*)
  239.  SetObjc (menu, num, GBOXTEXT, 0, 0, 0, CharHeight, {}, {}, title);
  240.  INC (num);
  241.  (*-- Suchposition im Baum festlegen --*)
  242.  IF subnum > 0 THEN
  243.   ob:= SubBegin + 1;
  244.   FOR j:= 1 TO (subnum - 3) DO  ob:= tree^[ob].obNext;  END;
  245.   IF ob < SubBegin THEN RETURN -1; END;
  246.   offset:= ob - 1;
  247.   j:= tree^[ob].obHead;
  248.  ELSE
  249.   ob:= 2;  offset:= 1;  j:= 0;
  250.  END;
  251.  (*-- Objekte addieren --*)
  252.  LOOP
  253.   i:= ScanFlags (tree, SearchType, j, type);
  254.   IF tree^[i].obWidth > maxW THEN  maxW:= tree^[i].obWidth;  END;
  255.   INCL (tree^[i].obFlags, SELECTABLE);
  256.   SetObjc (menu, num, tree^[i].obType, 0, maxH, tree^[i].obWidth,
  257.            CharHeight, tree^[i].obFlags, tree^[i].obState, tree^[i].obSpec.address);
  258.   INC (num);  INC (maxH, CharHeight);  j:= i + 1;
  259.   IF i = tree^[ob].obTail THEN  EXIT;  END;
  260.  END;
  261.  SameLength (menu, num, maxW);
  262.  PosMenu (menu, subnum, maxW, maxH);
  263.  (*-- Offset fr weitere Suche merken --*)
  264.  IF subnum = 0 THEN  SubBegin:= j; END;
  265.  RETURN offset;
  266. END MakeMenu;
  267.  
  268. PROCEDURE PopupMenu (menu: ADDRESS; title: ARRAY OF CHAR): sINTEGER; 
  269. VAR i, j, m, s, ret, len, ob, oldob, off1, off2: sINTEGER;
  270.     r:      tRect;
  271.     bool:   BOOLEAN;
  272.     t:      tObjcTree;
  273. BEGIN
  274.  IF menu = NIL THEN  RETURN -1;  END;
  275.  ScreenDim (mW, mH);
  276.  ret:= -1;  t:= menu;  len:= Length (title);  j:= 0;
  277.  MainTitle.tePtext:= ADR (title);
  278.  MainTitle.tePtmplt:= ADR (title);
  279.  MainTitle.tePvalid:= ADR (title);
  280.  MainTitle.teFont:= 3;
  281.  MainTitle.teFontid:= 0;
  282.  MainTitle.teJust:= 2;
  283.  MainTitle.teColor:= 011A1H;
  284.  MainTitle.teFontsize:= 0;
  285.  MainTitle.teThickness:= -1;
  286.  MainTitle.teTxtlen:= len;
  287.  MainTitle.teTmplen:= len;
  288.  off1:= MakeMenu (t, ADR(Main), ADR(MainTitle), 0, GTITLE);
  289.  CalcArea (ADR(Main), 0, r);
  290.  bool:= SaveArea (PrivateWS, mainArea, r);
  291.  moveable:= TRUE;
  292.  ObjcDraw (ADR(Main), 0, 8, screen);
  293.  MouseOn;
  294.  LOOP
  295.   m:= DoMenu (ADR(Main), TRUE, mainArea) + off1;
  296.   IF m < 1 THEN  ret:= -1;  EXIT; END;
  297.   IF Exit IN t^[m].obFlags THEN ret:= m; EXIT; END;
  298.   IF m > 2 THEN
  299.    len:= Length (Main[m - off1].obSpec.StringPtr^);
  300.    SubTitle.tePtext:= ADDRESS (Main[m - off1].obSpec.StringPtr);
  301.    SubTitle.tePtmplt:= ADDRESS (Main[m - off1].obSpec.StringPtr);
  302.    SubTitle.tePvalid:= ADDRESS (Main[m - off1].obSpec.StringPtr);
  303.    SubTitle.teFont:= 3;
  304.    SubTitle.teFontid:= 0;
  305.    SubTitle.teJust:= 2;
  306.    SubTitle.teColor:= 011A1H;
  307.    SubTitle.teFontsize:= 0;
  308.    SubTitle.teThickness:= -1;
  309.    SubTitle.teTxtlen:= len;
  310.    SubTitle.teTmplen:= len;
  311.    off2:= MakeMenu (t, ADR(Sub), ADR(SubTitle), m, GSTRING);
  312.    CalcArea (ADR(Sub), 0, r);
  313.    bool:= SaveArea (PrivateWS, subArea, r);
  314.    ObjcDraw (ADR(Sub), 0, 8, screen);
  315.    s:= DoMenu (ADR(Sub), TRUE, subArea);
  316.    RestoreArea (PrivateWS, subArea);
  317.    IF s > 0 THEN  ret:= s + off2;  EXIT; END;
  318.   END; (* IF m > 2 *)
  319.  END; (* LOOP *)
  320.  RestoreArea (PrivateWS, mainArea);
  321.  FreeArea (subArea);
  322.  FreeArea (mainArea);
  323.  RETURN ret;
  324. END PopupMenu;
  325.  
  326.  
  327. VAR posmode: (mouse, pos);
  328.     posX, posY: INTEGER;
  329.  
  330.  
  331. PROCEDURE StringPopup (REF string: ARRAY OF CHAR; title: ARRAY OF CHAR): sINTEGER;
  332. VAR i, j, m, s, l1, l2, maxW, maxH, num: sINTEGER;
  333.     mr, sr: tRect;
  334.     bool: BOOLEAN;
  335.     StrArray: ARRAY [0..49] OF tString;
  336.     t: tObjcTree;
  337. BEGIN
  338.  ScreenDim (mW, mH);
  339.  l1:= Length (string);  l2:= Length (title);
  340.  i:= 0;  j:= 0;  num:= 0;
  341.  (*-- Basisobjekt --*)
  342.  Main[num].obNext:=    -1;
  343.  Main[num].obHead:=    1;
  344.  Main[num].obTail:=    0;
  345.  Main[num].obType:=    GBOX;
  346.  Main[num].obFlags:=   {};
  347.  Main[num].obState:=   {MagicAES.SHADOWED};
  348.  Main[num].obSpec.Box.char:=  0C;
  349.  Main[num].obSpec.Box.frame:= 377C;
  350.  Main[num].obSpec.Box.flags:= {Bit12, Bit11};
  351.  Main[num].obX:=       0;
  352.  Main[num].obY:=       0;
  353.  Main[num].obWidth:=   0;
  354.  Main[num].obHeight:=  0;
  355.  INC (num);
  356.  IF l2 > 0 THEN
  357.   (*-- Titelzeile --*)
  358.   SetObjc (ADR(Main), num, GBOXTEXT, 0, 0, 0, CharHeight, {}, {}, ADR(MainTitle));
  359.   INC (num);
  360.   MainTitle.tePtext:= ADR (title);
  361.   MainTitle.tePtmplt:= ADR (title);
  362.   MainTitle.tePvalid:= ADR (title);
  363.   MainTitle.teFont:= 3;
  364.   MainTitle.teFontid:= 0;
  365.   MainTitle.teJust:= 2;
  366.   MainTitle.teColor:= 011A1H;
  367.   MainTitle.teFontsize:= 0;
  368.   MainTitle.teThickness:= -1;
  369.   MainTitle.teTxtlen:= l2;
  370.   MainTitle.teTmplen:= l2;
  371.   moveable:= TRUE;
  372.   maxH:= CharHeight + 1;
  373.  ELSE
  374.   moveable:= FALSE;
  375.   maxH:= 0;
  376.  END;
  377.  i:= 0;  j:= 0;  maxW:= (l2 + 2)* CharWidth;  
  378.  LOOP
  379.   s:= 0; 
  380.   WHILE (i < l1) AND (string[i] # '|') AND (s < cStrMax) DO
  381.    StrArray[j, s]:= string[i];  INC (i);  INC (s);
  382.   END;
  383.   StrArray[j, s]:= 0C;
  384.   SetObjc (ADR(Main), num, GSTRING, 0, maxH, (s + 2) * CharWidth, CharHeight, 
  385.            {SELECTABLE}, {}, ADR(StrArray[j]));
  386.   (* Korrektur von maxW fr Items breiter als die Titelzeile. Steffen Engel *)
  387.   maxW := Max (maxW, (s + 1) * CharWidth);
  388.   INC (num);  INC (j);  INC (maxH, CharHeight);
  389.   IF string[i] = 0C THEN  EXIT;  ELSE  INC (i);  END;
  390.  END;
  391.  SameLength (ADR(Main), num, maxW);
  392.  IF posmode = mouse THEN
  393.   PosMenu (ADR(Main), 0, maxW, maxH);
  394.  ELSE
  395.   WITH Main[0] DO
  396.    obX:= posX;  obY:= posY;  obWidth:= maxW;  obHeight:= maxH;
  397.    PlaceOnScreen (ADR(Main));
  398.   END;
  399.  END;
  400.  CalcArea (ADR(Main), 0, mr);
  401.  bool:= SaveArea (PrivateWS, mainArea, mr);
  402.  ObjcDraw (ADR(Main), 0, 8, screen);
  403.  MouseOn;
  404.  m:= DoMenu (ADR(Main), moveable, mainArea);
  405.  RestoreArea (PrivateWS, mainArea);
  406.  FreeArea (mainArea);
  407.  IF m > 0 THEN  RETURN m - 1;  ELSE  RETURN -1;  END;
  408. END StringPopup;
  409.  
  410. PROCEDURE PosPopup (x, y: INTEGER; REF string: ARRAY OF CHAR;
  411.                     title: ARRAY OF CHAR): sINTEGER;
  412. VAR i: INTEGER;
  413. BEGIN
  414.  posmode:= pos;  posX:= x;  posY:= y;
  415.  i:= StringPopup (string, title);
  416.  posmode:= mouse;
  417.  RETURN i;
  418. END PosPopup;
  419.  
  420. PROCEDURE TreePopup (tree: ADDRESS; x, y: sINTEGER; idx: sINTEGER): sINTEGER;
  421. VAR m,j : sINTEGER;
  422.     mr, sr: tRect;
  423.     bool: BOOLEAN;
  424.     t: tObjcTree;
  425. BEGIN
  426.  t:= tree;
  427.  ScreenDim (mW, mH);
  428.  WITH t^[0] DO
  429.   obX:= x;  obY:= y;  DEC (obY, idx * CharHeight);
  430.  END;
  431.  PlaceOnScreen (t);
  432.  CalcArea (t, 0, mr);
  433.  bool:= SaveArea (PrivateWS, mainArea, mr);
  434.  ObjcDraw (t, 0, 8, screen);
  435.  MouseOn;
  436.  m:= DoMenu (t, FALSE, mainArea);
  437.  RestoreArea (PrivateWS, mainArea);
  438.  FreeArea (mainArea);
  439.  IF m > 0 THEN  RETURN m;  ELSE  RETURN -1;  END;
  440. END TreePopup;
  441.  
  442. VAR init : INTEGER;
  443.  
  444. PROCEDURE InitMtPopups;
  445. BEGIN
  446.  IF init # 24867
  447.  THEN
  448.   screen.x:= DeskX;
  449.   screen.y:= DeskY;
  450.   screen.w:= MaxWidth;
  451.   screen.h:= MaxHeight;
  452.   bool:= NewAREA (mainArea);
  453.   bool:= NewAREA (subArea);
  454.   posmode:= mouse;
  455.   init := 24867
  456.  END;
  457. END InitMtPopups;
  458.  
  459. BEGIN
  460.  init := 0;
  461.  InitMtPopups;
  462. END mtPopups.
  463.